Software Vault: The Gold Collection/Software Vault - The Gold Collection (American Databankers) (1993).ISO/cdr05/mswlogo3.zip/MSWLOGO.ZIP/EXAMPLES.ZIP/TTT

Text File | 1993-04-13 | 4KB | 234 lines

;
; Function:
;
; Tic Tac Toc game
;
; To run:
;
; Load "ttt
; Call TTT
;
TO BEST :LIST
OP BEST1 FIRST :LIST LAST :LIST :YOURWINS
END

TO BEST1 :BOX1 :BOX2 :WINS
IF EMPTYP :WINS [OP :BOX2]
IF MEMBERP :BOX1 FIRST :WINS [OP BEST2 :BOX1 :BOX2 BF :WINS]
OP BEST1 :BOX1 :BOX2 BF :WINS
END

TO BEST2 :BOX1 :BOX2 :WINS
IF EMPTYP :WINS [OP :BOX2]
IF MEMBERP :BOX1 FIRST :WINS [OP :BOX1]
OP BEST2 :BOX1 :BOX2 BF :WINS
END

TO BOARD
CS HT
DRAWLINE [-20 -50] 0 120
DRAWLINE [20 -50] 0 120
DRAWLINE [-60 -10] 90 120
DRAWLINE [-60 30] 90 120
END

TO CHOOSE :SIDE
PR :SIDE
IF EQUALP :SIDE "X [CHOOSEX STOP]
IF EQUALP :SIDE "O [CHOOSEO STOP]
TYPE [HUH? TYPE X OR O:]
CHOOSE RC
END

TO CHOOSEO
MAKE "ME "X
MAKE "YOU "O
END

TO CHOOSEX
MAKE "ME "O
MAKE "YOU "X
END

TO DRAW :WHO :BOX
RUN SE WORD "DRAW :WHO :BOX
END

TO DRAWLINE :POS :HEAD :LEN
PU
SETPOS :POS
SETH :HEAD
PD
FD :LEN
END

TO DRAWO :BOX
MOVE :BOX
O
END

TO DRAWX :BOX
MOVE :BOX
X
END

TO FORK1 :LIST
IF EMPTYP :LIST [OP "FALSE]
IF THING WORD "HIT FIRST :LIST [MEPLAY FIRST :LIST OP "TRUE]
MAKE WORD "HIT FIRST :LIST "TRUE
OP FORK1 BF :LIST
END

TO FORKMOVE :LISTS
IF EMPTYP :LISTS [OP "FALSE]
IF FORK1 FIRST :LISTS [OP "TRUE]
OP FORKMOVE BF :LISTS
END

TO GETMOVE
TYPE [YOUR MOVE:]
OP TRYMOVE RC
END

TO INIT
MAKE "FREE [5 1 3 7 9 2 4 6 8]
MAKE "MYWINS []
MAKE "YOURWINS []
MAKE "FREEWINS [[1 5 9] [3 5 7] [1 2 3] [4 5 6] [7 8 9]     ~
                [1 4 7] [2 5 8] [3 6 9]]
PR [DO YOU WANT TO PLAY FIRST (X)]
TYPE [OR SECOND (O)? TYPE X OR O:]
CHOOSE RC
PR [FOR EACH MOVE, TYPE DIGIT 1-9.]
END

TO MEPLAY :BOX
DRAW :ME :BOX
PLAY :BOX "MYWINS "YOURWINS
END

TO MOVE :BOX
PU
SETPOS THING WORD "BOX :BOX
END

TO O
SETH 0
PU
FD 8
PD
REPEAT 8 [FD 12 RT 45]
END

TO PICKMOVE
LOCAL [HIT1 HIT2 HIT3 HIT4 HIT5 HIT6 HIT7 HIT8 HIT9]
IF WINMOVE SINGLE :MYWINS [OP "TRUE]
IF WINMOVE SINGLE :YOURWINS [OP "FALSE]
ZEROHITS :FREE
IF FORKMOVE :MYWINS [OP "FALSE]
IF NOT EMPTYP :MYWINS [MEPLAY BEST FIRST :MYWINS OP "FALSE]
MEPLAY FIRST :FREE
OP "FALSE
END

TO PLAY :BOX :PLAYER :OTHER
MAKE "FREE REMOVE :BOX :FREE
MAKE :PLAYER SHORTEN :BOX THING :PLAYER
MAKE :OTHER STRIP :BOX THING :OTHER
MAKE "FREEWINS UNFREE :BOX :PLAYER :FREEWINS
END

TO PLAYLOOP
IF EMPTYP :FREE [PR [TIE!] STOP]
IF GETMOVE [PR [YOU WIN!] STOP]
IF EMPTYP :FREE [PR [TIE!] STOP]
IF PICKMOVE [PR [I WIN!] STOP]
PLAYLOOP
END

TO REMOVE :THING :LIST
IF EMPTYP :LIST [OP []]
IF EQUALP :THING FIRST :LIST [OP BF :LIST]
OP FPUT FIRST :LIST REMOVE :THING BF :LIST
END

TO SHORTEN :BOX :LIST
IF EMPTYP :LIST [OP []]
IF MEMBERP :BOX FIRST :LIST     ~
   [OP FPUT REMOVE :BOX FIRST :LIST SHORTEN :BOX BF :LIST]
OP FPUT FIRST :LIST SHORTEN :BOX BF :LIST
END

TO SINGLE :LIST
IF EMPTYP :LIST [OP []]
IF EMPTYP BF FIRST :LIST [OP FIRST FIRST :LIST]
OP SINGLE BF :LIST
END

TO STRIP :BOX :LIST
IF EMPTYP :LIST [OP []]
IF MEMBERP :BOX FIRST :LIST [OP STRIP :BOX BF :LIST]
OP FPUT FIRST :LIST STRIP :BOX BF :LIST
END

TO TRYMOVE :BOX
PR :BOX
IF NOT MEMBERP :BOX :FREE [PR [NOT A VALID MOVE.] OP GETMOVE]
YOUPLAY :BOX
OP MEMBERP [] :YOURWINS
END

TO TTT
LOCAL [MYWINS YOURWINS FREEWINS FREE ME YOU]
SS
BOARD
INIT
IF EQUALP :ME "X [MEPLAY 5]
PLAYLOOP
END

TO UNFREE :BOX :PLAYER :LIST
IF EMPTYP :LIST [OP []]
IF MEMBERP :BOX FIRST :LIST ~
   [MAKE :PLAYER FPUT REMOVE :BOX FIRST :LIST THING :PLAYER ~
    OP UNFREE :BOX :PLAYER BF :LIST]
OP FPUT FIRST :LIST UNFREE :BOX :PLAYER BF :LIST
END

TO WINMOVE :MOVE
IF EMPTYP :MOVE [OP "FALSE]
MEPLAY :MOVE
OP "TRUE
END

TO X
SETH 45
PD
FD 40
BK 20
RT 90
FD 20
BK 40
END

TO YOUPLAY :BOX
DRAW :YOU :BOX
PLAY :BOX "YOURWINS "MYWINS
END

TO ZEROHITS :LIST
IF EMPTYP :LIST [STOP]
MAKE WORD "HIT FIRST :LIST "FALSE
ZEROHITS BF :LIST
END

MAKE "BOX1 [-54 36]
MAKE "BOX2 [-14 36]
MAKE "BOX3 [26 36]
MAKE "BOX4 [-54 -4]
MAKE "BOX5 [-14 -4]
MAKE "BOX6 [26 -4]
MAKE "BOX7 [-54 -44]
MAKE "BOX8 [-14 -44]
MAKE "BOX9 [26 -44]